home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Doc.Mod (.txt) < prev    next >
Oberon Text  |  1995-04-06  |  5KB  |  126 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 6 Apr 95
  6. Syntax12i.Scn.Fnt
  7. LineElems
  8. Alloc
  9. Syntax10b.Scn.Fnt
  10. FoldElems
  11. Syntax10i.Scn.Fnt
  12. (* code for all Oberons without the object model (all except HP, DEC, SGI) *)
  13. MODULE Doc;    (** SHML 15 Dec 93 / 
  14.     IMPORT Modules, Texts, TextFrames, Oberon;
  15.     CONST ConfigurationName = "Doc.Configuration.Text";
  16.     TYPE
  17.         String = ARRAY 32 OF CHAR;
  18.         Element = POINTER TO ElementDesc;
  19.         ElementDesc = RECORD
  20.             command, ext: String;
  21.             next: Element
  22.         END;
  23.     VAR root: Element; default: String; wr: Texts.Writer;
  24.     (* Support *)
  25.     PROCEDURE Str(s: ARRAY OF CHAR);    BEGIN Texts.WriteString(wr, s) END Str;
  26.     PROCEDURE Ch(ch: CHAR);    BEGIN Texts.Write(wr, ch) END Ch;
  27.     PROCEDURE Ln;    BEGIN Texts.WriteLn(wr); Texts.Append(Oberon.Log, wr.buf) END Ln;
  28.     PROCEDURE ScanFirst(VAR s: Texts.Scanner);    (* Open s on parameter list *)
  29.         VAR sel: Texts.Text; beg, end, time: LONGINT;
  30.     BEGIN
  31.         Texts.OpenScanner(s, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(s);
  32.         IF (s.class = Texts.Char) & (s.line = 0) & (s.c = "^") THEN
  33.             Oberon.GetSelection(sel, beg, end, time);
  34.             IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
  35.         END
  36.     END ScanFirst;
  37.     PROCEDURE Extension(name: ARRAY OF CHAR; VAR ext: ARRAY OF CHAR);
  38.         VAR i, j: INTEGER;
  39.     BEGIN
  40.         i := -1; REPEAT INC(i) UNTIL name[i] = 0X;
  41.         REPEAT DEC(i) UNTIL (name[i] = ".") OR (i = 0);
  42.         IF i = 0 THEN ext[0] := 0X
  43.         ELSE
  44.             j := -1; REPEAT INC(i); INC(j); ext[j] := name[i] UNTIL name[i] = 0X
  45.         END
  46.     END Extension;
  47.     PROCEDURE Search(ext: ARRAY OF CHAR; VAR prev: Element): Element;
  48.         VAR l: Element;
  49.     BEGIN
  50.         l := root; prev := NIL;
  51.         WHILE (l # NIL) & (l.ext # ext) DO prev := l; l := l.next END;
  52.         RETURN l
  53.     END Search;
  54.     PROCEDURE Call(command: ARRAY OF CHAR);
  55.         VAR res, i: INTEGER;
  56.     BEGIN
  57.         i := -1;
  58.         REPEAT INC(i) UNTIL (command[i] = ".") OR (command[i] = 0X);
  59.         IF command[i] = "." THEN
  60.             Oberon.Call(command, Oberon.Par, FALSE, res);
  61. (* delete this fold, if you run an Oberon with the object model (HP, DEC, SGI) *)
  62.             IF res > 0 THEN    (* not-object model error messages *)
  63.                 IF res = 1 THEN Str(Modules.importing); Str(" not found")
  64.                 ELSIF res = 2 THEN Str(Modules.importing); Str(" not an obj-file")
  65.                 ELSIF res = 3 THEN Str(Modules.importing); Str(" imports "); Str(Modules.imported); Str(" with bad key")
  66.                 ELSIF res = 4 THEN Str(Modules.importing); Str(" corrupted obj file")
  67.                 ELSIF res = 5 THEN Str(command); Str(" command not found")
  68.                 ELSIF res = 6 THEN Str(Modules.importing); Str(" has too many imports")
  69.                 ELSIF res = 7 THEN Str(Modules.importing); Str(" not enough space")
  70.                 END;
  71.                 Ln
  72.             ELSIF res < 0 THEN
  73.                 INC(i);
  74.                 WHILE command[i] # 0X DO Ch(command[i]); INC(i) END;
  75.                 Str(" not found"); Ln
  76.             END
  77.         END
  78.     END Call;
  79.     (** Commands **)
  80.     PROCEDURE Open*;    (** "^" | name    Open document name with installed Open command **)
  81.         VAR s: Texts.Scanner; this, prev: Element; ext: String;
  82.     BEGIN
  83.         ScanFirst(s);
  84.         IF s.class = Texts.Name THEN
  85.             Extension(s.s, ext); this := Search(ext, prev);
  86.             IF this # NIL THEN Call(this.command) ELSIF default # "" THEN Call(default) END
  87.         END
  88.     END Open;
  89.     PROCEDURE List*;    (** List all command - extension pairs **)
  90.         VAR this: Element;
  91.     BEGIN
  92.         Str("Doc.List"); Ln;
  93.         IF default # "" THEN Str(default); Str(" - *"); Ln END;
  94.         this := root;
  95.         WHILE this # NIL DO
  96.             Str(this.command); Str(" - "); Str(this.ext); Ln;
  97.             this := this.next
  98.         END
  99.     END List;
  100.     PROCEDURE Defaults*;    (** Clear all pairs and load default assignments from configuration file **)
  101.         VAR t: Texts.Text; s: Texts.Scanner; new, this, prev: Element;
  102.     BEGIN
  103.         root := NIL; default[0] := 0X;
  104.         t := TextFrames.Text(ConfigurationName);
  105.         IF t.len # 0 THEN
  106.             Texts.OpenScanner(s, t, 0); Texts.Scan(s);
  107.             WHILE ~s.eot & ((s.class = Texts.Name) OR (s.class = Texts.String)) DO
  108.                 NEW(new); COPY(s.s, new.command); Texts.Scan(s);
  109.                 IF (s.class = Texts.Char) & (s.c = "*") THEN default := new.command
  110.                 ELSIF (s.class = Texts.Name) OR (s.class = Texts.String) THEN
  111.                     COPY(s.s, new.ext);
  112.                     this := Search(new.ext, prev);    (* check for duplicates *)
  113.                     IF this = NIL THEN new.next := root; root := new    (* new entry *)
  114.                     ELSIF this.command # new.command THEN    (* new entry for existing extension -> remove this *)
  115.                         IF this = root THEN new.next := root.next; root := new
  116.                         ELSE new.next := this.next; prev.next := new
  117.                         END
  118.                     END
  119.                 END;
  120.                 Texts.Scan(s)
  121.             END
  122.         END
  123.     END Defaults;
  124. BEGIN Defaults; Texts.OpenWriter(wr)
  125. END Doc.
  126.